IRIX Installation Tools & Overlays 2002 November/SGI IRIX Installation Tools & Overlays 2002 November - Disc 4.iso/dist/infosearch.idb/usr/lib/infosearch/bin/namazu_sgi.z/namazu_sgi

Text File | 2002-10-15 | 5KB | 232 lines

#!/usr/bin/perl
#
# Copyright 1996-2002, Silicon Graphics, Inc.
# All Rights Reserved.
#
# This is UNPUBLISHED PROPRIETARY SOURCE CODE of Silicon Graphics, Inc.;
# the contents of this file may not be disclosed to third parties, copied or
# duplicated in any form, in whole or in part, without the prior written
# permission of Silicon Graphics, Inc.
#
# RESTRICTED RIGHTS LEGEND:
# Use, duplication or disclosure by the Government is subject to restrictions
# as set forth in subdivision (c)(1)(ii) of the Rights in Technical Data
# and Computer Software clause at DFARS 252.227-7013, and/or in similar or
# successor clauses in the FAR, DOD or NASA FAR Supplement. Unpublished -
# rights reserved under the Copyright Laws of the United States.
#
#  ----------
#  namazu_sgi
#  ----------
#  L10N search wrapper
#
#  Usage:
#       namazu_sgi [-p <db_pth>] <query>
#
#  requires perl5
#

$| = 1;

use strict;

# globals
#
package InfoSearch;

$InfoSearch::COLLECTION = $ENV{'COLLECTION'};
$InfoSearch::_WEB       = ($ENV{'REQUEST_METHOD'} ne '' ? 1 : 0);
$InfoSearch::_DB        = 'bks';
%InfoSearch::_bk_ttls   = ();

&main(@ARGV);
exit(0);



#######################################################################
#
# void main()
#
#######################################################################

sub main {

  my(@argv) = @_;
  unless ($argv[0]) {
        print "namazu_sgi: no arguments\n" if (${InfoSearch::_WEB} == 0);
        return;
  }
  if (!(-x "./namazu")) {
        print "namazu_sgi: no program\n" if (${InfoSearch::_WEB} == 0);
        return;
  }

  # pth  = /usr/share/Insight/library/SGI_bookshelves
  #
  my($db_pth, $bk, $ttl, $hits, $srch_str, $cmd, $lang) = '';
  my($i) = 0;
  while($i < (@argv + 0)) {

        if ($argv[$i] eq "-p") {

           splice(@argv, $i, 1);
           if( $argv[$i] ne '' ) {
               $db_pth = $argv[$i];
               splice(@argv, $i, 1);
           }

        } elsif ($argv[$i] eq "-db") {

           splice(@argv, $i, 1);
           if( $argv[$i] ne '' ) {
               $InfoSearch::_DB = $argv[$i];
               splice(@argv, $i, 1);
           }

        } elsif ($argv[$i] eq "-lang") {

           splice(@argv, $i, 1);
           if( $argv[$i] ne '' ) {
               $lang = $argv[$i];
               splice(@argv, $i, 1);
           }

        } else {
           $i++;
        }
  }

  # take whatever is left
  #
  $srch_str = join(' ', @argv);


  #---------------------------------------------------------
  # set the proper locale for us to work in...
  #
  # LC_CTYPE   needed for uc{first}, lc{first}
  # LC_COLLATE needed for lt, le, cmp, ge, gt, strcoll, sort
  #
  use locale;
  use POSIX qw(locale_h);
  use POSIX qw(strcoll);

  if( $lang ne '' ) {
      if (!(setlocale(LC_CTYPE, $lang))) {

          # on error, set to 'C'
          #
          $lang = 'C';
          setlocale(LC_CTYPE, $lang);
      }
      setlocale(LC_COLLATE, $lang);
  }


  # Set the path for security and taint checking.
  #
  $ENV{'PATH'} = "${InfoSearch::_TR}/usr/sbin:" .
                 "${InfoSearch::_TR}/usr/bin:"  .
                 "${InfoSearch::_TR}/bin:/usr/sbin:/usr/bin:/bin";

  # check
  #
  my($OK_CHARS) = "-a-zA-Z0-9_.*:;\+\/";
  my($BAD_CHARS) = "`'\"&<>,;";
  $db_pth =~ s/[^$OK_CHARS]//go;
  $srch_str =~ s/[$BAD_CHARS]//go;

  # default path
  #
  if( $db_pth eq '' ) {
      $db_pth = '/usr/share/Insight/library/SGI_bookshelves/SGIindex';
  }
  $cmd = "./namazu -a --result=sgi -h '${srch_str}' ${db_pth}";
  $db_pth =~ s/\/SGIindex$//;

  &get_booklist($db_pth);

  $i = 0;
  open(FP, "${cmd} |") || do {
    print "namazu_sgi: cmd failed ($cmd) : $!\n";
    return;
  };


  # parse up the result
  #
  while(<FP>) {

    if($i == 0) {
       if($_ =~ /<!-- HIT -->/i) {
          ($hits) = ($_ =~ m#\-\->([\d]+)<!\-\-#is);
          $i = 1;
          print "\n<P><B><font face=\"helvetica\" color=\"darkred\">",
                "  ${hits} document(s) found</font></B></P>\n\n";
       }
       next;
    }

    if( $_ =~ s/$db_pth//g ) {
        $bk = '';
        if( $_ =~ /\/books\/([^\/]+)\// ) {
            $bk = $1;
        }
    }

    if($_ =~ /<dl>/i) {
       $_ =~ s/<dl>/<TABLE CELLPADDING="1" CELLSPACING="6" BORDER="0">/;
    }
    if($_ =~ /<\/dl>/i) {
       print "</TABLE>\n";
       last;
    }

    if($_ =~ /XXDBXX/) {
       $_ =~ s/XXDBXX/${InfoSearch::_DB}/g;
       $_ =~ s/XXCOLLXX/${InfoSearch::COLLECTION}/g;
    }
    if($_ =~ /XXTTLXX/) {
       $ttl = ${InfoSearch::_bk_ttls}{"$bk"};
       $_ =~ s/XXTTLXX/$ttl/;
    }

    print $_;
  }
  close(FP);

  if(length($hits) == 0) {
     print "\n<P><B><font face=\"helvetica\" color=\"darkred\">",
           "  ** No documents found</font></B></P>\n\n";
  }

  return;
}


sub get_booklist {

  my($base) = @_;
  my($bk, $ttl) = '';

  open (FP, "cat $base/*/booklist.txt |") || return;
  while(<FP>) {

      ($bk, $ttl) = '';
      if( $_ =~ /NAME[\ \=]+\"([^\"]+)\"/i ) {
          $bk = $1;
          if( $_ =~ /ALIAS[\ \=]+\"([^\"]+)\"/i ) {
              $ttl = $1;
          } else {
              $ttl = $bk;
          }

          ${InfoSearch::_bk_ttls}{"$bk"} = "$ttl";
      }
  }
  close(FP);
}